home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 061-070 / amok66 / speed / speed.mod < prev    next >
Text File  |  1993-11-04  |  14KB  |  345 lines
  1. (* ------------------------------------------------------------------------
  2.    :Program.      Speed
  3.    :Contents.     Proceduren zur schnellen Speichermanipulation.
  4.    :Author.       Klaus Hlawaty.
  5.    :Address.      Waldhof
  6.    :Address.      3579 Schrecksbach
  7.    :History.      v1.0 - 16.Dec.90: Copy, CopyVar.
  8.    :History.      v1.1 - 17.Dec.90: Fill, VerGl.
  9.    :History.      v1.2 - 18.Dec.90: Umbau von POINTER auf ARRAY OF BYTE.
  10.    :History.      v2.0 - 07.Sep.91: Einbau des CopyMem aus Exec.
  11.    :History.      v2.1 - 09.Ocr.91: Einbau von FindByte & ReplaceByte
  12.    :History.      v3.0 - 15.Nov.91: Umbau auf Oberon v2.13.
  13.    :History.      v3.1 - 25.Nov.91: FillC.
  14.    :Copyright.    Freeware.
  15.    :Language.     Oberon v2.13
  16.    :Translator.   OBERON v2.13 / OLink v2.13d
  17.    :Imports.      Reg.
  18.    :Remarks.      Fill und Copy können durch die Angabe von:
  19.    :Remarks.      1.) Von[x] oder Nach[x] auch Variablenteile nutzen,
  20.    :Remarks.      2.) Nach[0] auch Variablen benutzen die größer als
  21.    :Remarks.          32767 sind.
  22.    :Remarks.      siehe Beispiele: CTest u.a. !
  23.    :Remarks.      zu v2.0: Hier habe ich CopyMem aus der ExecLibrary
  24.    :Remarks.               direkt eingebaut und dabei 'source' und 'dest'
  25.    :Remarks.               von ARRAY OF BYTE auf e.ADDRESS umgeändert,
  26.    :Remarks.               da sonst beim Copieren von Pointern nicht ab
  27.    :Remarks.               und AUF die Adresse der Variablen sondern
  28.    :Remarks.               die Adresse der Adresse kopiert wird, womit
  29.    :Remarks.               ein 'indischer Heiliger' zu Besuch kommt.
  30.    :Remarks.      zu v3.0: Bei Oberon v2.13 konnte ich CopyMem wieder
  31.    :Remarks.               'ausbauen'.
  32. ------------------------------------------------------------------------ *)
  33. MODULE Speed;
  34. (* $CopyArrays- *)
  35.  
  36. IMPORT
  37.        e:Exec,
  38.          Reg,
  39.        s:SYSTEM;
  40.  
  41. CONST
  42.       Byte* = 01;
  43.       Word* = 02;
  44.       Long* = 03;
  45.  
  46. VAR
  47.   exec * [4H] : e.ExecBasePtr;      (* Nötig für CopyMem siehe Exec *)
  48.  
  49. (* ===================================================================== *)
  50. (* ----------------------- Procedure aus Exec-Library ------------------ *)
  51. (* ===================================================================== *)
  52. PROCEDURE CopyMem      *{exec,-624}(source{8}     : s.ADDRESS;
  53.                                     dest{9}       : s.ADDRESS;
  54.                                     size{0}       : LONGINT);
  55. (* ------------------------------------------------------------------------
  56.    :Input.     source  : Adresse oder POINTER von der kopiert wird.
  57.                size    : Anzahl der Bytes zum Kopieren.
  58.    :Output.    dest    : Adresse oder POINTER auf die kopiert wird.
  59.    :Semantic.  Kopiert schnell beliebige Speicherbereiche, siehe Exec.
  60.    :Remark.    Benötige ich für COPY für POINTER ab Oberon 2.0 ?????
  61. ------------------------------------------------------------------------ *)
  62.  
  63. (* ===================================================================== *)
  64.  
  65. PROCEDURE Copy*{exec,-624}(Von {Reg.A0} : ARRAY OF BYTE;
  66.                            Nach{Reg.A1} : ARRAY OF BYTE;
  67.                            Anz {Reg.D0} : LONGINT);
  68. (* ------------------------------------------------------------------------
  69.    :Input.     Von  : Variable von der kopiert wird.
  70.                Anz  : Anzahl der Bytes zum Kopieren.
  71.    :Output.    Nach : Variable auf die kopiert wird.
  72.    :Semantic.  Kopiert schnell beliebige Arrays.
  73.    :Remark.    Nicht zum Kopieren über POINTERn (Ptr^ angeben, nicht Ptr).
  74. ------------------------------------------------------------------------ *)
  75.  
  76. PROCEDURE CopyVar*(VAR Von  : ARRAY OF BYTE;
  77.                    VAR Nach : ARRAY OF BYTE);
  78. (* ------------------------------------------------------------------------
  79.    :Input.     Von  : Variable von der kopiert wird.
  80.    :Output.    Nach : Variable auf die kopiert wird.
  81.    :Semantic.  Kopiert schnell und sicher (!?) ganze (!) Variablen,
  82.    :Semantic.  da die Anzahl der copierten Bytes der der kleineren
  83.    :Semantic.  Variable ist.
  84.    :Remark.    Vorsicht: CopyVar copiert nur ganze (!) Variablen fehlerfrei.
  85. ------------------------------------------------------------------------ *)
  86. VAR
  87.    LenV,
  88.    LenN,
  89.    Anz : LONGINT;
  90.  
  91. BEGIN
  92.    LenV := LEN(Von,0);
  93.    LenN := LEN(Nach,0);
  94.    IF(LenV < LenN)THEN
  95.       e.CopyMem(Von,Nach,LenV);
  96.    ELSE
  97.       e.CopyMem(Von,Nach,LenN);
  98.    END;
  99. END CopyVar;
  100.  
  101. PROCEDURE StrCopyAss*(Von{Reg.A0}  : s.ADDRESS;
  102.                       Nach{Reg.A1} : s.ADDRESS);
  103. (* $EntryExitCode- *)
  104. (* ------------------------------------------------------------------------
  105.    :Input.     Von  : String von dem kopiert wird.
  106.    :Output.    Nach : String auf den kopiert wird.
  107.    :Semantic.  Kopiert NULL terminierten C-String.
  108. ------------------------------------------------------------------------ *)
  109. BEGIN
  110. s.INLINE(
  111.   012D8H,                       (* StrCopy:  move.b  (a0)+,(a1)+ *)
  112.   066FCH,                       (*           bne     StrCopy     *)
  113.   04E75H                        (*           rts                 *)
  114.         );
  115. END StrCopyAss;
  116.  
  117. PROCEDURE StrCopy*(VAR Von  ,
  118.                        Nach : ARRAY OF CHAR);
  119. (* ------------------------------------------------------------------------
  120.    :Input.     Von  : String von dem kopiert wird.
  121.    :Output.    Nach : String auf den kopiert wird.
  122.    :Semantic.  Kopiert NULL terminierten C-String.
  123. ------------------------------------------------------------------------ *)
  124. BEGIN
  125.   StrCopyAss(s.ADR(Von),s.ADR(Nach));
  126. END StrCopy;
  127.  
  128. (* --------------------- Locale Assembler Module für Fill ---------------- *)
  129. PROCEDURE FillB(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS);
  130. (* $EntryExitCode- *)
  131. BEGIN
  132. s.INLINE(
  133.        010C0H,                (* move.b  D0,(A0)+         *)
  134.        051C9H,0FFFCH,         (* dbra    D1,.LOOP         *)
  135.        04E75H                 (* RTS                      *)
  136.       );
  137. END FillB;
  138. PROCEDURE FillW(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS);
  139. (* $EntryExitCode- *)
  140. BEGIN
  141. s.INLINE(
  142.        030C0H,                (* move.w  D0,(A0)+         *)
  143.        051C9H,0FFFCH,         (* dbra    D1,.LOOP         *)
  144.        04E75H                 (* RTS                      *)
  145.       );
  146. END FillW;
  147. PROCEDURE FillL(Was{0} : LONGINT; Anz{1} : LONGINT; Nach{8} : s.ADDRESS);
  148. (* $EntryExitCode- *)
  149. BEGIN
  150. s.INLINE(
  151.        020C0H,                (* move.l  D0,(A0)+         *)
  152.        051C9H,0FFFCH,         (* dbra    D1,.LOOP         *)
  153.        04E75H                 (* RTS                      *)
  154.       );
  155. END FillL;
  156. (* $EntryExitCode- *)
  157. PROCEDURE Conv*(Was{Reg.D0} : s.ADDRESS) : LONGINT;
  158. BEGIN
  159. s.INLINE(
  160.        04E75H                 (* RTS                      *)
  161.       );
  162. END Conv;
  163. (* ----------------------------------------------------------------------- *)
  164.  
  165. PROCEDURE Fill*(    Filler : LONGINT;
  166.                     Anzahl : LONGINT;
  167.                 VAR Nach   : ARRAY OF BYTE;
  168.                     Type   : INTEGER);
  169. (* ------------------------------------------------------------------------
  170.    :Input.     Filler : Füllwert.
  171.    :Input.     Anzahl : der Bytes, Worte oder Langworte zum Füllen.
  172.    :Input.     Type   : Bestimmt ob Filler als 'Byte', 'Word' oder
  173.    :Input.              'Long'word Variable interpretiert wird.
  174.    .Input.              siehe CONST
  175.    :Output.    Nach   : Variable die gefüllt wird.
  176.    :Semantic.  Füllt Variablen (ARRAY maximal 32767).
  177. ------------------------------------------------------------------------ *)
  178.  
  179. BEGIN
  180.    CASE Type OF
  181.       Byte : FillB(Filler, Anzahl, s.ADR(Nach)) |
  182.       Word : FillW(Filler, Anzahl, s.ADR(Nach)) |
  183.       Long : FillL(Filler, Anzahl, s.ADR(Nach))
  184.    ELSE
  185.       (* Pech gehabt, bitte selbst aufpassen *);
  186.    END(* CASE *);
  187. END Fill;
  188.  
  189. PROCEDURE FillC*(    Filler : CHAR;
  190.                      Anzahl : LONGINT;
  191.                  VAR Nach   : ARRAY OF CHAR);
  192. (* ------------------------------------------------------------------------
  193.    :Input.     Filler : FüllZeichen.
  194.    :Input.     Anzahl : der Zeichen zum Füllen.
  195.    :Output.    Nach   : String der gefüllt wird.
  196.    :Semantic.  Füllt String (ARRAY maximal 32767).
  197. ------------------------------------------------------------------------ *)
  198.  
  199. BEGIN
  200.   FillB(s.VAL(SHORTINT,Filler), Anzahl, s.ADR(Nach));
  201. END FillC;
  202.  
  203. (* ------------ Assembler Module für Addressmanipulation ---------------- *)
  204.  
  205. PROCEDURE IncAByte*(Adr{Reg.D0} : s.ADDRESS) : s.ADDRESS;
  206. (* ------------------------------------------------------------------------
  207.    :Input.      Adr    : Adresse.
  208.    :Output.     RETURN : Adr + 1.
  209.    :Semantic.   Incrementiert Adresse um 1.
  210. ------------------------------------------------------------------------ *)
  211. (* $EntryExitCode- *)
  212. BEGIN
  213.   s.INLINE(
  214.                              (* IncA1:                               *)
  215.   05280H,                    (*           ADDQ.L  #1,D0              *)
  216.   04E75H                     (*           rts                        *)
  217.                              (*           END                        *)
  218.   ) (* INLINE *);
  219. END IncAByte;
  220. (* $EntryExitCode+ *)
  221.  
  222. PROCEDURE IncA*(   Adr{Reg.D0} : s.ADDRESS;
  223.                 Offset{Reg.D1} : LONGINT) : s.ADDRESS;
  224. (* ------------------------------------------------------------------------
  225.    :Input.      Adr    : Adresse.
  226.    :Input.      Offset : Offset.
  227.    :Output.     RETURN : Adr + Offset.
  228.    :Semantic.   Addierte Offset zur Adresse.
  229. ------------------------------------------------------------------------ *)
  230.  
  231. (* $EntryExitCode- *)
  232. BEGIN
  233.   s.INLINE(
  234.  
  235.                              (* IncA:                                *)
  236.   0D081H,                    (*           ADD.L   D1,D0              *)
  237.   04E75H                     (*           rts                        *)
  238.                              (*           END                        *)
  239.   ) (* INLINE *);
  240. END IncA ;
  241. (* $EntryExitCode+ *)
  242.  
  243. PROCEDURE DecA*(   Adr{Reg.D0} : s.ADDRESS;
  244.                 Offset{Reg.D1} : LONGINT) : s.ADDRESS;
  245. (* ------------------------------------------------------------------------
  246.    :Input.      Adr    : Adresse.
  247.    :Input.      Offset : Offset.
  248.    :Output.     RETURN : Adr - Offset.
  249.    :Semantic.   Subtrahiere Offset von Adresse.
  250. ------------------------------------------------------------------------ *)
  251.  
  252. (* $EntryExitCode- *)
  253. BEGIN
  254.   s.INLINE(
  255.  
  256.                              (* DecA:                                *)
  257.   09081H,                    (*           SUB.L   D1,D0              *)
  258.   04E75H                     (*           rts                        *)
  259.                              (*           END                        *)
  260.   ) (* INLINE *);
  261. END DecA;
  262. (* $EntryExitCode+ *)
  263.  
  264.  
  265. (* ------------ Assembler Module für Byte/Char-Manipulationen ----------- *)
  266. PROCEDURE ReplaceChar*(Von{Reg.A0}   : s.ADDRESS;
  267.                        Was{Reg.D1}   : CHAR;
  268.                        Womit{Reg.A1} : CHAR);
  269. (* ------------------------------------------------------------------------
  270.    :Input.     Von   : String der verändert werden soll.
  271.                Was   : Charakter der mit ...
  272.                Womit : ausgetauscht werden soll.
  273.    :Output.    Von   : wird geändert.
  274.    :Semantic.  Tauscht im String 'Von' alle 'Was'-Charkters mit
  275.    :Semantic.  'Womit' aus.
  276.    :Remark.    Der String muß mit einem Nullcharakter abgeschloßen werden.
  277.    :Remark.    Man darf niemals gleiche Charaktere 'austauschen',
  278.    :Remark.    z.B.: niemals 'e' austauschen mit 'e'.
  279. ------------------------------------------------------------------------ *)
  280. (* $EntryExitCode- *)
  281. BEGIN
  282. s.INLINE(
  283.                        (* ReplaceByte:                 *)
  284.  023C2H, 00000H,0001CH,(*            move.l  D2,Var    *)
  285.  02409H,               (*            move.l  A1,D2     *)
  286.                        (* Loop:                        *)
  287.  01018H,               (*            move.b  (A0)+,D0  *)
  288.  06708H,               (*            beq     Ende      *)
  289.  0B200H,               (*            cmp.b   D0,D1     *)
  290.  066F8H,               (*            bne     Loop      *)
  291.  01102H,               (*            move.b  D2,-(A0)  *)
  292.  060F4H,               (*            bra     Loop      *)
  293.                        (* Ende:                        *)
  294.  03439H, 00000H,0001CH,(*            move    Var,D2    *)
  295.  04E75H,               (*            rts               *)
  296.                        (* Var:                         *)
  297.  00000H,
  298.  00000H,
  299.  00000H,
  300.  00000H
  301.          );
  302. END ReplaceChar;
  303. (* $EntryExitCode+ *)
  304.  
  305. PROCEDURE FindChar*(Von{Reg.A0} : s.ADDRESS;
  306.                     Was{Reg.D1} : CHAR      ) : s.ADDRESS (* Wo *);
  307. (* ------------------------------------------------------------------------
  308.    :Input.     Von    : String in dem gesucht wird.
  309.                Was    : Charakter nach dem gesucht wird.
  310.    :Output.    RETURN : Adresse des Charakters im RAM.
  311.    :Semantic.  Sucht im String 'Von' nach 'Was'-Charakter.
  312.    :Remark.    Der String muß mit einem Nullcharakter abgeschloßen werden.
  313. ------------------------------------------------------------------------ *)
  314. (* $EntryExitCode- *)
  315. BEGIN
  316. s.INLINE(
  317.                 (* FindChar:                  *)
  318.         01018H, (*           move.b  (A0)+,D0 *)
  319.         06704H, (*           beq     Ende     *)
  320.         0B200H, (*           cmp.b   D0,D1    *)
  321.         066F8H, (*           bne     FindChar *)
  322.                 (* Ende:                      *)
  323.         02008H, (*           move.l  A0,D0    *)
  324.         04E75H  (*           rts              *)
  325.        );
  326. END FindChar;
  327.  
  328. (* $EntryExitCode+ *)
  329. (* ----------------------------------------------------------------------- *)
  330. PROCEDURE SearchChar*(Von : s.ADDRESS;
  331.                       Was : CHAR       ) : s.ADDRESS;
  332. (* ------------------------------------------------------------------------
  333.    :Input.     Von    : String in dem gesucht wird.
  334.                Was    : Charakter nach dem gesucht wird.
  335.    :Output.    RETURN : Nummer des Charakters im String.
  336.    :Semantic.  Sucht im String 'Von' nach 'Was'-Charakter.
  337.    :Remark.    Der String muß mit einem Nullcharakter abgeschloßen werden.
  338. ------------------------------------------------------------------------ *)
  339. BEGIN
  340.   RETURN DecA(FindChar(Von,Was),Von);
  341. END SearchChar;
  342.  
  343. END Speed.
  344.  
  345.